home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / perl.h < prev    next >
C/C++ Source or Header  |  1998-07-21  |  60KB  |  2,361 lines

  1. /*    perl.h
  2.  *
  3.  *    Copyright (c) 1987-1997, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9. #ifndef H_PERL
  10. #define H_PERL 1
  11. #define OVERLOAD
  12.  
  13. #ifdef PERL_FOR_X2P
  14. /*
  15.  * This file is being used for x2p stuff. 
  16.  * Above symbol is defined via -D in 'x2p/Makefile.SH'
  17.  * Decouple x2p stuff from some of perls more extreme eccentricities. 
  18.  */
  19. #undef EMBED
  20. #undef NO_EMBED
  21. #define NO_EMBED
  22. #undef MULTIPLICITY
  23. #undef USE_STDIO
  24. #define USE_STDIO
  25. #endif /* PERL_FOR_X2P */
  26.  
  27. #ifdef PERL_OBJECT
  28.  
  29. /* PERL_OBJECT explained  - DickH and DougL @ ActiveState.com
  30.  
  31. Defining PERL_OBJECT turns on creation of a C++ object that
  32. contains all writable core perl global variables and functions.
  33. Stated another way, all necessary global variables and functions
  34. are members of a big C++ object. This object's class is CPerlObj.
  35. This allows a Perl Host to have multiple, independent perl
  36. interpreters in the same process space. This is very important on
  37. Win32 systems as the overhead of process creation is quite high --
  38. this could be even higher than the script compile and execute time
  39. for small scripts.
  40.  
  41. The perl executable implementation on Win32 is composed of perl.exe
  42. (the Perl Host) and perlX.dll. (the Perl Core). This allows the
  43. same Perl Core to easily be embedded in other applications that use
  44. the perl interpreter.
  45.  
  46. +-----------+
  47. | Perl Host |
  48. +-----------+
  49.       ^
  50.       |
  51.       v
  52. +-----------+   +-----------+
  53. | Perl Core |<->| Extension |
  54. +-----------+   +-----------+ ...
  55.  
  56. Defining PERL_OBJECT has the following effects:
  57.  
  58. PERL CORE
  59. 1. CPerlObj is defined (this is the PERL_OBJECT)
  60. 2. all static functions that needed to access either global
  61. variables or functions needed are made member functions
  62. 3. all writable static variables are made member variables
  63. 4. all global variables and functions are defined as:
  64.     #define var CPerlObj::Perl_var
  65.     #define func CPerlObj::Perl_func
  66.     * these are in objpp.h
  67. This necessitated renaming some local variables and functions that
  68. had the same name as a global variable or function. This was
  69. probably a _good_ thing anyway.
  70.  
  71.  
  72. EXTENSIONS
  73. 1. Access to global variables and perl functions is through a
  74. pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is
  75. made transparent to extension developers by the following macros:
  76.     #define var pPerl->Perl_var
  77.     #define func pPerl->Perl_func
  78.     * these are done in objXSUB.h
  79. This requires that the extension be compiled as C++, which means
  80. that the code must be ANSI C and not K&R C. For K&R extensions,
  81. please see the C API notes located in Win32/GenCAPI.pl. This script
  82. creates a perlCAPI.lib that provides a K & R compatible C interface
  83. to the PERL_OBJECT.
  84. 2. Local variables and functions cannot have the same name as perl's
  85. variables or functions since the macros will redefine these. Look for
  86. this if you get some strange error message and it does not look like
  87. the code that you had written. This often happens with variables that
  88. are local to a function.
  89.  
  90. PERL HOST
  91. 1. The perl host is linked with perlX.lib to get perl_alloc. This
  92. function will return a pointer to CPerlObj (the PERL_OBJECT). It
  93. takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h
  94. for more information on this).
  95. 2. The perl host calls the same functions as normally would be
  96. called in setting up and running a perl script, except that the
  97. functions are now member functions of the PERL_OBJECT.
  98.  
  99. */
  100.  
  101.  
  102. class CPerlObj;
  103.  
  104. #define STATIC
  105. #define CPERLscope(x) CPerlObj::x
  106. #define CPERLproto CPerlObj *
  107. #define _CPERLproto ,CPERLproto
  108. #define CPERLarg CPerlObj *pPerl
  109. #define CPERLarg_ CPERLarg,
  110. #define _CPERLarg ,CPERLarg
  111. #define PERL_OBJECT_THIS this
  112. #define _PERL_OBJECT_THIS ,this
  113. #define PERL_OBJECT_THIS_ this,
  114. #define CALLRUNOPS (this->*PL_runops)
  115. #define CALLREGCOMP (this->*PL_regcompp)
  116. #define CALLREGEXEC (this->*PL_regexecp)
  117.  
  118. #else /* !PERL_OBJECT */
  119.  
  120. #define STATIC static
  121. #define CPERLscope(x) x
  122. #define CPERLproto
  123. #define _CPERLproto
  124. #define CPERLarg void
  125. #define CPERLarg_
  126. #define _CPERLarg
  127. #define PERL_OBJECT_THIS
  128. #define _PERL_OBJECT_THIS
  129. #define PERL_OBJECT_THIS_
  130. #define CALLRUNOPS PL_runops
  131. #define CALLREGCOMP (*PL_regcompp)
  132. #define CALLREGEXEC (*PL_regexecp)
  133.  
  134. #endif /* PERL_OBJECT */
  135.  
  136. #define VOIDUSED 1
  137. #include "config.h"
  138.  
  139. #include "embed.h"
  140.  
  141. #undef START_EXTERN_C
  142. #undef END_EXTERN_C
  143. #undef EXTERN_C
  144. #ifdef __cplusplus
  145. #  define START_EXTERN_C extern "C" {
  146. #  define END_EXTERN_C }
  147. #  define EXTERN_C extern "C"
  148. #else
  149. #  define START_EXTERN_C 
  150. #  define END_EXTERN_C 
  151. #  define EXTERN_C
  152. #endif
  153.  
  154. #ifdef OP_IN_REGISTER
  155. #  ifdef __GNUC__
  156. #    define stringify_immed(s) #s
  157. #    define stringify(s) stringify_immed(s)
  158. #ifdef EMBED
  159. register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
  160. #else
  161. register struct op *op asm(stringify(OP_IN_REGISTER));
  162. #endif
  163. #  endif
  164. #endif
  165.  
  166. /*
  167.  * STMT_START { statements; } STMT_END;
  168.  * can be used as a single statement, as in
  169.  * if (x) STMT_START { ... } STMT_END; else ...
  170.  *
  171.  * Trying to select a version that gives no warnings...
  172.  */
  173. #if !(defined(STMT_START) && defined(STMT_END))
  174. # if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus)
  175. #   define STMT_START    (void)(    /* gcc supports ``({ STATEMENTS; })'' */
  176. #   define STMT_END    )
  177. # else
  178.    /* Now which other defined()s do we need here ??? */
  179. #  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
  180. #   define STMT_START    if (1)
  181. #   define STMT_END    else (void)0
  182. #  else
  183. #   define STMT_START    do
  184. #   define STMT_END    while (0)
  185. #  endif
  186. # endif
  187. #endif
  188.  
  189. #define NOOP (void)0
  190.  
  191. #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
  192.  
  193. /*
  194.  * SOFT_CAST can be used for args to prototyped functions to retain some
  195.  * type checking; it only casts if the compiler does not know prototypes.
  196.  */
  197. #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
  198. #define SOFT_CAST(type)    
  199. #else
  200. #define SOFT_CAST(type)    (type)
  201. #endif
  202.  
  203. #ifndef BYTEORDER  /* Should never happen -- byteorder is in config.h */
  204. #   define BYTEORDER 0x1234
  205. #endif
  206.  
  207. /* Overall memory policy? */
  208. #ifndef CONSERVATIVE
  209. #   define LIBERAL 1
  210. #endif
  211.  
  212. /*
  213.  * The following contortions are brought to you on behalf of all the
  214.  * standards, semi-standards, de facto standards, not-so-de-facto standards
  215.  * of the world, as well as all the other botches anyone ever thought of.
  216.  * The basic theory is that if we work hard enough here, the rest of the
  217.  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
  218.  */
  219.  
  220. /* define this once if either system, instead of cluttering up the src */
  221. #if defined(MSDOS) || defined(atarist) || defined(WIN32)
  222. #define DOSISH 1
  223. #endif
  224.  
  225. #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
  226. # define STANDARD_C 1
  227. #endif
  228.  
  229. #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
  230. # define DONT_DECLARE_STD 1
  231. #endif
  232.  
  233. #if defined(HASVOLATILE) || defined(STANDARD_C)
  234. #   ifdef __cplusplus
  235. #    define VOL        // to temporarily suppress warnings
  236. #   else
  237. #    define VOL volatile
  238. #   endif
  239. #else
  240. #   define VOL
  241. #endif
  242.  
  243. #define TAINT        (PL_tainted = TRUE)
  244. #define TAINT_NOT    (PL_tainted = FALSE)
  245. #define TAINT_IF(c)    if (c) { PL_tainted = TRUE; }
  246. #define TAINT_ENV()    if (PL_tainting) { taint_env(); }
  247. #define TAINT_PROPER(s)    if (PL_tainting) { taint_proper(no_security, s); }
  248.  
  249. /* XXX All process group stuff is handled in pp_sys.c.  Should these 
  250.    defines move there?  If so, I could simplify this a lot. --AD  9/96.
  251. */
  252. /* Process group stuff changed from traditional BSD to POSIX.
  253.    perlfunc.pod documents the traditional BSD-style syntax, so we'll
  254.    try to preserve that, if possible.
  255. */
  256. #ifdef HAS_SETPGID
  257. #  define BSD_SETPGRP(pid, pgrp)    setpgid((pid), (pgrp))
  258. #else
  259. #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
  260. #    define BSD_SETPGRP(pid, pgrp)    setpgrp((pid), (pgrp))
  261. #  else
  262. #    ifdef HAS_SETPGRP2  /* DG/UX */
  263. #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
  264. #    endif
  265. #  endif
  266. #endif
  267. #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
  268. #  define HAS_SETPGRP  /* Well, effectively it does . . . */
  269. #endif
  270.  
  271. /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
  272.     our life easier :-) so we'll try it.
  273. */
  274. #ifdef HAS_GETPGID
  275. #  define BSD_GETPGRP(pid)        getpgid((pid))
  276. #else
  277. #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
  278. #    define BSD_GETPGRP(pid)        getpgrp((pid))
  279. #  else
  280. #    ifdef HAS_GETPGRP2  /* DG/UX */
  281. #      define BSD_GETPGRP(pid)        getpgrp2((pid))
  282. #    endif
  283. #  endif
  284. #endif
  285. #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
  286. #  define HAS_GETPGRP  /* Well, effectively it does . . . */
  287. #endif
  288.  
  289. /* These are not exact synonyms, since setpgrp() and getpgrp() may 
  290.    have different behaviors, but perl.h used to define USE_BSDPGRP
  291.    (prior to 5.003_05) so some extension might depend on it.
  292. */
  293. #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
  294. #  ifndef USE_BSDPGRP
  295. #    define USE_BSDPGRP
  296. #  endif
  297. #endif
  298.  
  299. #ifndef _TYPES_        /* If types.h defines this it's easy. */
  300. #   ifndef major        /* Does everyone's types.h define this? */
  301. #    include <sys/types.h>
  302. #   endif
  303. #endif
  304.  
  305. #ifdef __cplusplus
  306. #  ifndef I_STDARG
  307. #    define I_STDARG 1
  308. #  endif
  309. #endif
  310.  
  311. #ifdef I_STDARG
  312. #  include <stdarg.h>
  313. #else
  314. #  ifdef I_VARARGS
  315. #    include <varargs.h>
  316. #  endif
  317. #endif
  318.  
  319. #include "iperlsys.h"
  320.  
  321. #ifdef USE_NEXT_CTYPE
  322.  
  323. #if NX_CURRENT_COMPILER_RELEASE >= 400
  324. #include <objc/NXCType.h>
  325. #else /*  NX_CURRENT_COMPILER_RELEASE < 400 */
  326. #include <appkit/NXCType.h>
  327. #endif /*  NX_CURRENT_COMPILER_RELEASE >= 400 */
  328.  
  329. #else /* !USE_NEXT_CTYPE */
  330. #include <ctype.h>
  331. #endif /* USE_NEXT_CTYPE */
  332.  
  333. #ifdef METHOD     /* Defined by OSF/1 v3.0 by ctype.h */
  334. #undef METHOD
  335. #endif
  336.  
  337. #ifdef I_LOCALE
  338. #   include <locale.h>
  339. #endif
  340.  
  341. #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
  342. #   define USE_LOCALE
  343. #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
  344.        && defined(HAS_STRXFRM)
  345. #    define USE_LOCALE_COLLATE
  346. #   endif
  347. #   if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
  348. #    define USE_LOCALE_CTYPE
  349. #   endif
  350. #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
  351. #    define USE_LOCALE_NUMERIC
  352. #   endif
  353. #endif /* !NO_LOCALE && HAS_SETLOCALE */
  354.  
  355. #include <setjmp.h>
  356.  
  357. #ifdef I_SYS_PARAM
  358. #   ifdef PARAM_NEEDS_TYPES
  359. #    include <sys/types.h>
  360. #   endif
  361. #   include <sys/param.h>
  362. #endif
  363.  
  364.  
  365. /* Use all the "standard" definitions? */
  366. #if defined(STANDARD_C) && defined(I_STDLIB)
  367. #   include <stdlib.h>
  368. #endif
  369.  
  370. #define MEM_SIZE Size_t
  371.  
  372. /* This comes after <stdlib.h> so we don't try to change the standard
  373.  * library prototypes; we'll use our own in proto.h instead. */
  374.  
  375. #ifdef MYMALLOC
  376.  
  377. #   ifdef HIDEMYMALLOC
  378. #    define malloc  Mymalloc
  379. #    define calloc  Mycalloc
  380. #    define realloc Myrealloc
  381. #    define free    Myfree
  382. Malloc_t Mymalloc _((MEM_SIZE nbytes));
  383. Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
  384. Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
  385. Free_t   Myfree _((Malloc_t where));
  386. #   endif
  387. #   ifdef EMBEDMYMALLOC
  388. #    define malloc  Perl_malloc
  389. #    define calloc  Perl_calloc
  390. #    define realloc Perl_realloc
  391. /* VMS' external symbols are case-insensitive, and there's already a */
  392. /* perl_free in perl.h */
  393. #ifdef VMS
  394. #    define free    Perl_myfree
  395. #else
  396. #    define free    Perl_free
  397. #endif
  398. Malloc_t Perl_malloc _((MEM_SIZE nbytes));
  399. Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
  400. Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
  401. #ifdef VMS
  402. Free_t   Perl_myfree _((Malloc_t where));
  403. #else
  404. Free_t   Perl_free _((Malloc_t where));
  405. #endif
  406. #   endif
  407.  
  408. #   undef safemalloc
  409. #   undef safecalloc
  410. #   undef saferealloc
  411. #   undef safefree
  412. #   define safemalloc  malloc
  413. #   define safecalloc  calloc
  414. #   define saferealloc realloc
  415. #   define safefree    free
  416.  
  417. #endif /* MYMALLOC */
  418.  
  419. #if defined(STANDARD_C) && defined(I_STDDEF)
  420. #   include <stddef.h>
  421. #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
  422. #else
  423. #   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
  424. #endif
  425.  
  426. #if defined(I_STRING) || defined(__cplusplus)
  427. #   include <string.h>
  428. #else
  429. #   include <strings.h>
  430. #endif
  431.  
  432. #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
  433. #define strchr index
  434. #define strrchr rindex
  435. #endif
  436.  
  437. #ifdef I_MEMORY
  438. #  include <memory.h>
  439. #endif
  440.  
  441. #ifdef HAS_MEMCPY
  442. #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
  443. #    ifndef memcpy
  444.         extern char * memcpy _((char*, char*, int));
  445. #    endif
  446. #  endif
  447. #else
  448. #   ifndef memcpy
  449. #    ifdef HAS_BCOPY
  450. #        define memcpy(d,s,l) bcopy(s,d,l)
  451. #    else
  452. #        define memcpy(d,s,l) my_bcopy(s,d,l)
  453. #    endif
  454. #   endif
  455. #endif /* HAS_MEMCPY */
  456.  
  457. #ifdef HAS_MEMSET
  458. #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
  459. #    ifndef memset
  460.     extern char *memset _((char*, int, int));
  461. #    endif
  462. #  endif
  463. #else
  464. #  define memset(d,c,l) my_memset(d,c,l)
  465. #endif /* HAS_MEMSET */
  466.  
  467. #if !defined(HAS_MEMMOVE) && !defined(memmove)
  468. #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
  469. #    define memmove(d,s,l) bcopy(s,d,l)
  470. #   else
  471. #    if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
  472. #        define memmove(d,s,l) memcpy(d,s,l)
  473. #    else
  474. #        define memmove(d,s,l) my_bcopy(s,d,l)
  475. #    endif
  476. #   endif
  477. #endif
  478.  
  479. #if defined(mips) && defined(ultrix) && !defined(__STDC__)
  480. #   undef HAS_MEMCMP
  481. #endif
  482.  
  483. #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
  484. #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
  485. #    ifndef memcmp
  486.     extern int memcmp _((char*, char*, int));
  487. #    endif
  488. #  endif
  489. #  ifdef BUGGY_MSC
  490.   #  pragma function(memcmp)
  491. #  endif
  492. #else
  493. #   ifndef memcmp
  494. #    define memcmp     my_memcmp
  495. #   endif
  496. #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
  497.  
  498. #ifndef memzero
  499. #   ifdef HAS_MEMSET
  500. #    define memzero(d,l) memset(d,0,l)
  501. #   else
  502. #    ifdef HAS_BZERO
  503. #        define memzero(d,l) bzero(d,l)
  504. #    else
  505. #        define memzero(d,l) my_bzero(d,l)
  506. #    endif
  507. #   endif
  508. #endif
  509.  
  510. #ifndef HAS_BCMP
  511. #   ifndef bcmp
  512. #    define bcmp(s1,s2,l) memcmp(s1,s2,l)
  513. #   endif
  514. #endif /* !HAS_BCMP */
  515.  
  516. #ifdef I_NETINET_IN
  517. #   include <netinet/in.h>
  518. #endif
  519.  
  520. #ifdef I_ARPA_INET
  521. #   include <arpa/inet.h>
  522. #endif
  523.  
  524. #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
  525. /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
  526.  * (the neo-BSD seem to do this).  */
  527. #   undef SF_APPEND
  528. #endif
  529.  
  530. #ifdef I_SYS_STAT
  531. #   include <sys/stat.h>
  532. #endif
  533.  
  534. /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
  535.    like UTekV) are broken, sometimes giving false positives.  Undefine
  536.    them here and let the code below set them to proper values.
  537.  
  538.    The ghs macro stands for GreenHills Software C-1.8.5 which
  539.    is the C compiler for sysV88 and the various derivatives.
  540.    This header file bug is corrected in gcc-2.5.8 and later versions.
  541.    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
  542.  
  543. #if defined(uts) || (defined(m88k) && defined(ghs))
  544. #   undef S_ISDIR
  545. #   undef S_ISCHR
  546. #   undef S_ISBLK
  547. #   undef S_ISREG
  548. #   undef S_ISFIFO
  549. #   undef S_ISLNK
  550. #endif
  551.  
  552. #ifdef I_TIME
  553. #   include <time.h>
  554. #endif
  555.  
  556. #ifdef I_SYS_TIME
  557. #   ifdef I_SYS_TIME_KERNEL
  558. #    define KERNEL
  559. #   endif
  560. #   include <sys/time.h>
  561. #   ifdef I_SYS_TIME_KERNEL
  562. #    undef KERNEL
  563. #   endif
  564. #endif
  565.  
  566. #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
  567. #    include <sys/times.h>
  568. #endif
  569.  
  570. #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
  571. #   undef HAS_STRERROR
  572. #endif
  573.  
  574. #include <errno.h>
  575. #ifdef HAS_SOCKET
  576. #   ifdef I_NET_ERRNO
  577. #     include <net/errno.h>
  578. #   endif
  579. #endif
  580.  
  581. #ifdef VMS
  582. #   define SETERRNO(errcode,vmserrcode) \
  583.     STMT_START {            \
  584.         set_errno(errcode);        \
  585.         set_vaxc_errno(vmserrcode);    \
  586.     } STMT_END
  587. #else
  588. #   define SETERRNO(errcode,vmserrcode) errno = (errcode)
  589. #endif
  590.  
  591. #ifdef USE_THREADS
  592. #  define ERRSV (thr->errsv)
  593. #  define ERRHV (thr->errhv)
  594. #  define DEFSV THREADSV(0)
  595. #  define SAVE_DEFSV save_threadsv(0)
  596. #else
  597. #  define ERRSV GvSV(PL_errgv)
  598. #  define ERRHV GvHV(PL_errgv)
  599. #  define DEFSV GvSV(PL_defgv)
  600. #  define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
  601. #endif /* USE_THREADS */
  602.  
  603. #ifndef errno
  604.     extern int errno;     /* ANSI allows errno to be an lvalue expr */
  605. #endif
  606.  
  607. #ifdef HAS_STRERROR
  608. #       ifdef VMS
  609.     char *strerror _((int,...));
  610. #       else
  611. #ifndef DONT_DECLARE_STD
  612.     char *strerror _((int));
  613. #endif
  614. #       endif
  615. #       ifndef Strerror
  616. #           define Strerror strerror
  617. #       endif
  618. #else
  619. #    ifdef HAS_SYS_ERRLIST
  620.     extern int sys_nerr;
  621.     extern char *sys_errlist[];
  622. #       ifndef Strerror
  623. #           define Strerror(e) \
  624.         ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
  625. #       endif
  626. #   endif
  627. #endif
  628.  
  629. #ifdef I_SYS_IOCTL
  630. #   ifndef _IOCTL_
  631. #    include <sys/ioctl.h>
  632. #   endif
  633. #endif
  634.  
  635. #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
  636. #   ifdef HAS_SOCKETPAIR
  637. #    undef HAS_SOCKETPAIR
  638. #   endif
  639. #   ifdef I_NDBM
  640. #    undef I_NDBM
  641. #   endif
  642. #endif
  643.  
  644. #if INTSIZE == 2
  645. #   define htoni htons
  646. #   define ntohi ntohs
  647. #else
  648. #   define htoni htonl
  649. #   define ntohi ntohl
  650. #endif
  651.  
  652. /* Configure already sets Direntry_t */
  653. #if defined(I_DIRENT)
  654. #   include <dirent.h>
  655. #   if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
  656. #    include <sys/dir.h>
  657. #   endif
  658. #else
  659. #   ifdef I_SYS_NDIR
  660. #    include <sys/ndir.h>
  661. #   else
  662. #    ifdef I_SYS_DIR
  663. #        ifdef hp9000s500
  664. #        include <ndir.h>    /* may be wrong in the future */
  665. #        else
  666. #        include <sys/dir.h>
  667. #        endif
  668. #    endif
  669. #   endif
  670. #endif
  671.  
  672. #ifdef FPUTS_BOTCH
  673. /* work around botch in SunOS 4.0.1 and 4.0.2 */
  674. #   ifndef fputs
  675. #    define fputs(sv,fp) fprintf(fp,"%s",sv)
  676. #   endif
  677. #endif
  678.  
  679. /*
  680.  * The following gobbledygook brought to you on behalf of __STDC__.
  681.  * (I could just use #ifndef __STDC__, but this is more bulletproof
  682.  * in the face of half-implementations.)
  683.  */
  684.  
  685. #ifndef S_IFMT
  686. #   ifdef _S_IFMT
  687. #    define S_IFMT _S_IFMT
  688. #   else
  689. #    define S_IFMT 0170000
  690. #   endif
  691. #endif
  692.  
  693. #ifndef S_ISDIR
  694. #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
  695. #endif
  696.  
  697. #ifndef S_ISCHR
  698. #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
  699. #endif
  700.  
  701. #ifndef S_ISBLK
  702. #   ifdef S_IFBLK
  703. #    define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
  704. #   else
  705. #    define S_ISBLK(m) (0)
  706. #   endif
  707. #endif
  708.  
  709. #ifndef S_ISREG
  710. #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
  711. #endif
  712.  
  713. #ifndef S_ISFIFO
  714. #   ifdef S_IFIFO
  715. #    define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
  716. #   else
  717. #    define S_ISFIFO(m) (0)
  718. #   endif
  719. #endif
  720.  
  721. #ifndef S_ISLNK
  722. #   ifdef _S_ISLNK
  723. #    define S_ISLNK(m) _S_ISLNK(m)
  724. #   else
  725. #    ifdef _S_IFLNK
  726. #        define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
  727. #    else
  728. #        ifdef S_IFLNK
  729. #        define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
  730. #        else
  731. #        define S_ISLNK(m) (0)
  732. #        endif
  733. #    endif
  734. #   endif
  735. #endif
  736.  
  737. #ifndef S_ISSOCK
  738. #   ifdef _S_ISSOCK
  739. #    define S_ISSOCK(m) _S_ISSOCK(m)
  740. #   else
  741. #    ifdef _S_IFSOCK
  742. #        define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
  743. #    else
  744. #        ifdef S_IFSOCK
  745. #        define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
  746. #        else
  747. #        define S_ISSOCK(m) (0)
  748. #        endif
  749. #    endif
  750. #   endif
  751. #endif
  752.  
  753. #ifndef S_IRUSR
  754. #   ifdef S_IREAD
  755. #    define S_IRUSR S_IREAD
  756. #    define S_IWUSR S_IWRITE
  757. #    define S_IXUSR S_IEXEC
  758. #   else
  759. #    define S_IRUSR 0400
  760. #    define S_IWUSR 0200
  761. #    define S_IXUSR 0100
  762. #   endif
  763. #   define S_IRGRP (S_IRUSR>>3)
  764. #   define S_IWGRP (S_IWUSR>>3)
  765. #   define S_IXGRP (S_IXUSR>>3)
  766. #   define S_IROTH (S_IRUSR>>6)
  767. #   define S_IWOTH (S_IWUSR>>6)
  768. #   define S_IXOTH (S_IXUSR>>6)
  769. #endif
  770.  
  771. #ifndef S_ISUID
  772. #   define S_ISUID 04000
  773. #endif
  774.  
  775. #ifndef S_ISGID
  776. #   define S_ISGID 02000
  777. #endif
  778.  
  779. #ifdef ff_next
  780. #   undef ff_next
  781. #endif
  782.  
  783. #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
  784. #   define SLOPPYDIVIDE
  785. #endif
  786.  
  787. #ifdef UV
  788. #undef UV
  789. #endif
  790.  
  791. /*  XXX QUAD stuff is not currently supported on most systems.
  792.     Specifically, perl internals don't support long long.  Among
  793.     the many problems is that some compilers support long long,
  794.     but the underlying library functions (such as sprintf) don't.
  795.     Some things do work (such as quad pack/unpack on convex);
  796.     also some systems use long long for the fpos_t typedef.  That
  797.     seems to work too.
  798.  
  799.     The IV type is supposed to be long enough to hold any integral
  800.     value or a pointer.
  801.     --Andy Dougherty    August 1996
  802. */
  803.  
  804. #ifdef cray
  805. #   define Quad_t int
  806. #else
  807. #   ifdef convex
  808. #    define Quad_t long long
  809. #   else
  810. #    if LONGSIZE == 8
  811. #        define Quad_t long
  812. #    endif
  813. #   endif
  814. #endif
  815.  
  816. /* XXX Experimental set-up for long long.  Just add -DUSE_LONG_LONG
  817.    to your ccflags.  --Andy Dougherty   4/1998
  818. */
  819. #ifdef USE_LONG_LONG
  820. #  if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
  821. #    define Quad_t long long
  822. #  endif
  823. #endif
  824.  
  825. #ifdef Quad_t
  826. #   define HAS_QUAD
  827.     typedef Quad_t IV;
  828.     typedef unsigned Quad_t UV;
  829. #   define IV_MAX PERL_QUAD_MAX
  830. #   define IV_MIN PERL_QUAD_MIN
  831. #   define UV_MAX PERL_UQUAD_MAX
  832. #   define UV_MIN PERL_UQUAD_MIN
  833. #else
  834.     typedef long IV;
  835.     typedef unsigned long UV;
  836. #   define IV_MAX PERL_LONG_MAX
  837. #   define IV_MIN PERL_LONG_MIN
  838. #   define UV_MAX PERL_ULONG_MAX
  839. #   define UV_MIN PERL_ULONG_MIN
  840. #endif
  841.  
  842. /* Previously these definitions used hardcoded figures. 
  843.  * It is hoped these formula are more portable, although
  844.  * no data one way or another is presently known to me.
  845.  * The "PERL_" names are used because these calculated constants
  846.  * do not meet the ANSI requirements for LONG_MAX, etc., which
  847.  * need to be constants acceptable to #if - kja
  848.  *    define PERL_LONG_MAX        2147483647L
  849.  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
  850.  *    define PERL ULONG_MAX       4294967295L
  851.  */
  852.  
  853. #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
  854. #  include <limits.h>
  855. #else
  856. #ifdef I_VALUES
  857. #  include <values.h>
  858. #endif
  859. #endif
  860.  
  861. /*
  862.  * Try to figure out max and min values for the integral types.  THE CORRECT
  863.  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
  864.  * following hacks are used if neither limits.h or values.h provide them:
  865.  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
  866.  *              for types <  int:  (unsigned TYPE)~(unsigned)0
  867.  *    The argument to ~ must be unsigned so that later signed->unsigned
  868.  *    conversion can't modify the value's bit pattern (e.g. -0 -> +0),
  869.  *    and it must not be smaller than int because ~ does integral promotion.
  870.  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
  871.  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
  872.  *    The latter is a hack which happens to work on some machines but
  873.  *    does *not* catch any random system, or things like integer types
  874.  *    with NaN if that is possible.
  875.  *
  876.  * All of the types are explicitly cast to prevent accidental loss of
  877.  * numeric range, and in the hope that they will be less likely to confuse
  878.  * over-eager optimizers.
  879.  *
  880.  */
  881.  
  882. #define PERL_UCHAR_MIN ((unsigned char)0)
  883.  
  884. #ifdef UCHAR_MAX
  885. #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
  886. #else
  887. #  ifdef MAXUCHAR
  888. #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
  889. #  else
  890. #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
  891. #  endif
  892. #endif
  893.  
  894. /*
  895.  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
  896.  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
  897.  * depending on local options. Until Configure detects this (or at least
  898.  * detects whether the "signed" keyword is available) the CHAR ranges
  899.  * will not be included. UCHAR functions normally.
  900.  *                                                           - kja
  901.  */
  902.  
  903. #define PERL_USHORT_MIN ((unsigned short)0)
  904.  
  905. #ifdef USHORT_MAX
  906. #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
  907. #else
  908. #  ifdef MAXUSHORT
  909. #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
  910. #  else
  911. #    ifdef USHRT_MAX
  912. #      define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
  913. #    else
  914. #      define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
  915. #    endif
  916. #  endif
  917. #endif
  918.  
  919. #ifdef SHORT_MAX
  920. #  define PERL_SHORT_MAX ((short)SHORT_MAX)
  921. #else
  922. #  ifdef MAXSHORT    /* Often used in <values.h> */
  923. #    define PERL_SHORT_MAX ((short)MAXSHORT)
  924. #  else
  925. #    ifdef SHRT_MAX
  926. #      define PERL_SHORT_MAX ((short)SHRT_MAX)
  927. #    else
  928. #      define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
  929. #    endif
  930. #  endif
  931. #endif
  932.  
  933. #ifdef SHORT_MIN
  934. #  define PERL_SHORT_MIN ((short)SHORT_MIN)
  935. #else
  936. #  ifdef MINSHORT
  937. #    define PERL_SHORT_MIN ((short)MINSHORT)
  938. #  else
  939. #    ifdef SHRT_MIN
  940. #      define PERL_SHORT_MIN ((short)SHRT_MIN)
  941. #    else
  942. #      define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
  943. #    endif
  944. #  endif
  945. #endif
  946.  
  947. #ifdef UINT_MAX
  948. #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
  949. #else
  950. #  ifdef MAXUINT
  951. #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
  952. #  else
  953. #    define PERL_UINT_MAX       (~(unsigned int)0)
  954. #  endif
  955. #endif
  956.  
  957. #define PERL_UINT_MIN ((unsigned int)0)
  958.  
  959. #ifdef INT_MAX
  960. #  define PERL_INT_MAX ((int)INT_MAX)
  961. #else
  962. #  ifdef MAXINT    /* Often used in <values.h> */
  963. #    define PERL_INT_MAX ((int)MAXINT)
  964. #  else
  965. #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
  966. #  endif
  967. #endif
  968.  
  969. #ifdef INT_MIN
  970. #  define PERL_INT_MIN ((int)INT_MIN)
  971. #else
  972. #  ifdef MININT
  973. #    define PERL_INT_MIN ((int)MININT)
  974. #  else
  975. #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
  976. #  endif
  977. #endif
  978.  
  979. #ifdef ULONG_MAX
  980. #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
  981. #else
  982. #  ifdef MAXULONG
  983. #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
  984. #  else
  985. #    define PERL_ULONG_MAX       (~(unsigned long)0)
  986. #  endif
  987. #endif
  988.  
  989. #define PERL_ULONG_MIN ((unsigned long)0L)
  990.  
  991. #ifdef LONG_MAX
  992. #  define PERL_LONG_MAX ((long)LONG_MAX)
  993. #else
  994. #  ifdef MAXLONG    /* Often used in <values.h> */
  995. #    define PERL_LONG_MAX ((long)MAXLONG)
  996. #  else
  997. #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
  998. #  endif
  999. #endif
  1000.  
  1001. #ifdef LONG_MIN
  1002. #  define PERL_LONG_MIN ((long)LONG_MIN)
  1003. #else
  1004. #  ifdef MINLONG
  1005. #    define PERL_LONG_MIN ((long)MINLONG)
  1006. #  else
  1007. #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
  1008. #  endif
  1009. #endif
  1010.  
  1011. #ifdef HAS_QUAD
  1012.  
  1013. #  ifdef UQUAD_MAX
  1014. #    define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
  1015. #  else
  1016. #    define PERL_UQUAD_MAX    (~(UV)0)
  1017. #  endif
  1018.  
  1019. #  define PERL_UQUAD_MIN ((UV)0)
  1020.  
  1021. #  ifdef QUAD_MAX
  1022. #    define PERL_QUAD_MAX ((IV)QUAD_MAX)
  1023. #  else
  1024. #    define PERL_QUAD_MAX     ((IV) (PERL_UQUAD_MAX >> 1))
  1025. #  endif
  1026.  
  1027. #  ifdef QUAD_MIN
  1028. #    define PERL_QUAD_MIN ((IV)QUAD_MIN)
  1029. #  else
  1030. #    define PERL_QUAD_MIN     (-PERL_QUAD_MAX - ((3 & -1) == 3))
  1031. #  endif
  1032.  
  1033. #endif
  1034.  
  1035. typedef MEM_SIZE STRLEN;
  1036.  
  1037. typedef struct op OP;
  1038. typedef struct cop COP;
  1039. typedef struct unop UNOP;
  1040. typedef struct binop BINOP;
  1041. typedef struct listop LISTOP;
  1042. typedef struct logop LOGOP;
  1043. typedef struct condop CONDOP;
  1044. typedef struct pmop PMOP;
  1045. typedef struct svop SVOP;
  1046. typedef struct gvop GVOP;
  1047. typedef struct pvop PVOP;
  1048. typedef struct loop LOOP;
  1049.  
  1050. typedef struct Outrec Outrec;
  1051. typedef struct interpreter PerlInterpreter;
  1052. #ifndef __BORLANDC__
  1053. typedef struct ff FF;        /* XXX not defined anywhere, should go? */
  1054. #endif
  1055. typedef struct sv SV;
  1056. typedef struct av AV;
  1057. typedef struct hv HV;
  1058. typedef struct cv CV;
  1059. typedef struct regexp REGEXP;
  1060. typedef struct gp GP;
  1061. typedef struct gv GV;
  1062. typedef struct io IO;
  1063. typedef struct context PERL_CONTEXT;
  1064. typedef struct block BLOCK;
  1065.  
  1066. typedef struct magic MAGIC;
  1067. typedef struct xrv XRV;
  1068. typedef struct xpv XPV;
  1069. typedef struct xpviv XPVIV;
  1070. typedef struct xpvuv XPVUV;
  1071. typedef struct xpvnv XPVNV;
  1072. typedef struct xpvmg XPVMG;
  1073. typedef struct xpvlv XPVLV;
  1074. typedef struct xpvav XPVAV;
  1075. typedef struct xpvhv XPVHV;
  1076. typedef struct xpvgv XPVGV;
  1077. typedef struct xpvcv XPVCV;
  1078. typedef struct xpvbm XPVBM;
  1079. typedef struct xpvfm XPVFM;
  1080. typedef struct xpvio XPVIO;
  1081. typedef struct mgvtbl MGVTBL;
  1082. typedef union any ANY;
  1083.  
  1084. #include "handy.h"
  1085.  
  1086. #ifdef PERL_OBJECT
  1087. typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int));
  1088. #else
  1089. typedef I32 (*filter_t) _((int, SV *, int));
  1090. #endif
  1091.  
  1092. #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
  1093. #define FILTER_DATA(idx)       (AvARRAY(PL_rsfp_filters)[idx])
  1094. #define FILTER_ISREADER(idx)       (idx >= AvFILLp(PL_rsfp_filters))
  1095.  
  1096. #ifdef DOSISH
  1097. # if defined(OS2)
  1098. #   include "os2ish.h"
  1099. # else
  1100. #   include "dosish.h"
  1101. # endif
  1102. #else
  1103. # if defined(VMS)
  1104. #   include "vmsish.h"
  1105. # else
  1106. #   if defined(PLAN9)
  1107. #     include "./plan9/plan9ish.h"
  1108. #   else
  1109. #     if defined(MPE)
  1110. #       include "mpeix/mpeixish.h"
  1111. #     else
  1112. #       include "unixish.h"
  1113. #     endif
  1114. #   endif
  1115. # endif
  1116. #endif         
  1117.  
  1118. #ifndef FUNC_NAME_TO_PTR
  1119. #define FUNC_NAME_TO_PTR(name)        name
  1120. #endif
  1121.  
  1122. /* 
  1123.  * USE_THREADS needs to be after unixish.h as <pthread.h> includes
  1124.  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
  1125.  * this results in many functions being undeclared which bothers C++
  1126.  * May make sense to have threads after "*ish.h" anyway
  1127.  */
  1128.  
  1129. #ifdef USE_THREADS
  1130.    /* pending resolution of licensing issues, we avoid the erstwhile
  1131.     * atomic.h everywhere */
  1132. #  define EMULATE_ATOMIC_REFCOUNTS
  1133.  
  1134. #  ifdef FAKE_THREADS
  1135. #    include "fakethr.h"
  1136. #  else
  1137. #    ifdef WIN32
  1138. #      include <win32thread.h>
  1139. #    else
  1140. #      ifdef OS2
  1141. #        include "os2thread.h"
  1142. #      else
  1143. #        include <pthread.h>
  1144. typedef pthread_t perl_os_thread;
  1145. typedef pthread_mutex_t perl_mutex;
  1146. typedef pthread_cond_t perl_cond;
  1147. typedef pthread_key_t perl_key;
  1148. #      endif /* OS2 */
  1149. #    endif /* WIN32 */
  1150. #  endif /* FAKE_THREADS */
  1151. #endif /* USE_THREADS */
  1152.  
  1153.  
  1154.   
  1155. #ifdef VMS
  1156. #   define STATUS_NATIVE    PL_statusvalue_vms
  1157. #   define STATUS_NATIVE_EXPORT \
  1158.     ((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms)
  1159. #   define STATUS_NATIVE_SET(n)                        \
  1160.     STMT_START {                            \
  1161.         PL_statusvalue_vms = (n);                    \
  1162.         if ((I32)PL_statusvalue_vms == -1)                \
  1163.         PL_statusvalue = -1;                    \
  1164.         else if (PL_statusvalue_vms & STS$M_SUCCESS)        \
  1165.         PL_statusvalue = 0;                    \
  1166.         else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0)    \
  1167.         PL_statusvalue = 1 << 8;                \
  1168.         else                            \
  1169.         PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8;    \
  1170.     } STMT_END
  1171. #   define STATUS_POSIX    PL_statusvalue
  1172. #   ifdef VMSISH_STATUS
  1173. #    define STATUS_CURRENT    (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
  1174. #   else
  1175. #    define STATUS_CURRENT    STATUS_POSIX
  1176. #   endif
  1177. #   define STATUS_POSIX_SET(n)                \
  1178.     STMT_START {                    \
  1179.         PL_statusvalue = (n);                \
  1180.         if (PL_statusvalue != -1) {            \
  1181.         PL_statusvalue &= 0xFFFF;            \
  1182.         PL_statusvalue_vms = PL_statusvalue ? 44 : 1;    \
  1183.         }                        \
  1184.         else PL_statusvalue_vms = -1;            \
  1185.     } STMT_END
  1186. #   define STATUS_ALL_SUCCESS    (PL_statusvalue = 0, PL_statusvalue_vms = 1)
  1187. #   define STATUS_ALL_FAILURE    (PL_statusvalue = 1, PL_statusvalue_vms = 44)
  1188. #else
  1189. #   define STATUS_NATIVE    STATUS_POSIX
  1190. #   define STATUS_NATIVE_EXPORT    STATUS_POSIX
  1191. #   define STATUS_NATIVE_SET    STATUS_POSIX_SET
  1192. #   define STATUS_POSIX        PL_statusvalue
  1193. #   define STATUS_POSIX_SET(n)        \
  1194.     STMT_START {            \
  1195.         PL_statusvalue = (n);        \
  1196.         if (PL_statusvalue != -1)    \
  1197.         PL_statusvalue &= 0xFFFF;    \
  1198.     } STMT_END
  1199. #   define STATUS_CURRENT STATUS_POSIX
  1200. #   define STATUS_ALL_SUCCESS    (PL_statusvalue = 0)
  1201. #   define STATUS_ALL_FAILURE    (PL_statusvalue = 1)
  1202. #endif
  1203.  
  1204. /* Some unistd.h's give a prototype for pause() even though
  1205.    HAS_PAUSE ends up undefined.  This causes the #define
  1206.    below to be rejected by the compmiler.  Sigh.
  1207. */
  1208. #ifdef HAS_PAUSE
  1209. #define Pause    pause
  1210. #else
  1211. #define Pause() sleep((32767<<16)+32767)
  1212. #endif
  1213.  
  1214. #ifndef IOCPARM_LEN
  1215. #   ifdef IOCPARM_MASK
  1216.     /* on BSDish systes we're safe */
  1217. #    define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
  1218. #   else
  1219.     /* otherwise guess at what's safe */
  1220. #    define IOCPARM_LEN(x)    256
  1221. #   endif
  1222. #endif
  1223.  
  1224. #ifdef UNION_ANY_DEFINITION
  1225. UNION_ANY_DEFINITION;
  1226. #else
  1227. union any {
  1228.     void*    any_ptr;
  1229.     I32        any_i32;
  1230.     IV        any_iv;
  1231.     long    any_long;
  1232.     void    (CPERLscope(*any_dptr)) _((void*));
  1233. };
  1234. #endif
  1235.  
  1236. #ifdef USE_THREADS
  1237. #define ARGSproto struct perl_thread *thr
  1238. #else
  1239. #define ARGSproto void
  1240. #endif /* USE_THREADS */
  1241.  
  1242. /* Work around some cygwin32 problems with importing global symbols */
  1243. #if defined(CYGWIN32) && defined(DLLIMPORT) 
  1244. #   include "cw32imp.h"
  1245. #endif
  1246.  
  1247. #include "regexp.h"
  1248. #include "sv.h"
  1249. #include "util.h"
  1250. #include "form.h"
  1251. #include "gv.h"
  1252. #include "cv.h"
  1253. #include "opcode.h"
  1254. #include "op.h"
  1255. #include "cop.h"
  1256. #include "av.h"
  1257. #include "hv.h"
  1258. #include "mg.h"
  1259. #include "scope.h"
  1260. #include "bytecode.h"
  1261. #include "byterun.h"
  1262.  
  1263. /* Current curly descriptor */
  1264. typedef struct curcur CURCUR;
  1265. struct curcur {
  1266.     int        parenfloor;    /* how far back to strip paren data */
  1267.     int        cur;        /* how many instances of scan we've matched */
  1268.     int        min;        /* the minimal number of scans to match */
  1269.     int        max;        /* the maximal number of scans to match */
  1270.     int        minmod;        /* whether to work our way up or down */
  1271.     regnode *    scan;        /* the thing to match */
  1272.     regnode *    next;        /* what has to match after it */
  1273.     char *    lastloc;    /* where we started matching this scan */
  1274.     CURCUR *    oldcc;        /* current curly before we started this one */
  1275. };
  1276.  
  1277. typedef struct _sublex_info SUBLEXINFO;
  1278. struct _sublex_info {
  1279.     I32 super_state;    /* lexer state to save */
  1280.     I32 sub_inwhat;    /* "lex_inwhat" to use */
  1281.     OP *sub_op;        /* "lex_op" to use */
  1282. };
  1283.  
  1284. #ifdef PERL_OBJECT
  1285. struct magic_state {
  1286.     SV* mgs_sv;
  1287.     U32 mgs_flags;
  1288. };
  1289. typedef struct magic_state MGS;
  1290.  
  1291. typedef struct {
  1292.     I32 len_min;
  1293.     I32 len_delta;
  1294.     I32 pos_min;
  1295.     I32 pos_delta;
  1296.     SV *last_found;
  1297.     I32 last_end;            /* min value, <0 unless valid. */
  1298.     I32 last_start_min;
  1299.     I32 last_start_max;
  1300.     SV **longest;            /* Either &l_fixed, or &l_float. */
  1301.     SV *longest_fixed;
  1302.     I32 offset_fixed;
  1303.     SV *longest_float;
  1304.     I32 offset_float_min;
  1305.     I32 offset_float_max;
  1306.     I32 flags;
  1307. } scan_data_t;
  1308.  
  1309. typedef I32 CHECKPOINT;
  1310. #endif /* PERL_OBJECT */
  1311.  
  1312. /* work around some libPW problems */
  1313. #ifdef DOINIT
  1314. EXT char Error[1];
  1315. #endif
  1316.  
  1317. #if defined(iAPX286) || defined(M_I286) || defined(I80286)
  1318. #   define I286
  1319. #endif
  1320.  
  1321. #if defined(htonl) && !defined(HAS_HTONL)
  1322. #define HAS_HTONL
  1323. #endif
  1324. #if defined(htons) && !defined(HAS_HTONS)
  1325. #define HAS_HTONS
  1326. #endif
  1327. #if defined(ntohl) && !defined(HAS_NTOHL)
  1328. #define HAS_NTOHL
  1329. #endif
  1330. #if defined(ntohs) && !defined(HAS_NTOHS)
  1331. #define HAS_NTOHS
  1332. #endif
  1333. #ifndef HAS_HTONL
  1334. #if (BYTEORDER & 0xffff) != 0x4321
  1335. #define HAS_HTONS
  1336. #define HAS_HTONL
  1337. #define HAS_NTOHS
  1338. #define HAS_NTOHL
  1339. #define MYSWAP
  1340. #define htons my_swap
  1341. #define htonl my_htonl
  1342. #define ntohs my_swap
  1343. #define ntohl my_ntohl
  1344. #endif
  1345. #else
  1346. #if (BYTEORDER & 0xffff) == 0x4321
  1347. #undef HAS_HTONS
  1348. #undef HAS_HTONL
  1349. #undef HAS_NTOHS
  1350. #undef HAS_NTOHL
  1351. #endif
  1352. #endif
  1353.  
  1354. /*
  1355.  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
  1356.  * -DWS
  1357.  */
  1358. #if BYTEORDER != 0x1234
  1359. # define HAS_VTOHL
  1360. # define HAS_VTOHS
  1361. # define HAS_HTOVL
  1362. # define HAS_HTOVS
  1363. # if BYTEORDER == 0x4321
  1364. #  define vtohl(x)    ((((x)&0xFF)<<24)    \
  1365.             +(((x)>>24)&0xFF)    \
  1366.             +(((x)&0x0000FF00)<<8)    \
  1367.             +(((x)&0x00FF0000)>>8)    )
  1368. #  define vtohs(x)    ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
  1369. #  define htovl(x)    vtohl(x)
  1370. #  define htovs(x)    vtohs(x)
  1371. # endif
  1372.     /* otherwise default to functions in util.c */
  1373. #endif
  1374.  
  1375. #ifdef CASTNEGFLOAT
  1376. #define U_S(what) ((U16)(what))
  1377. #define U_I(what) ((unsigned int)(what))
  1378. #define U_L(what) ((U32)(what))
  1379. #else
  1380. EXTERN_C U32 cast_ulong _((double));
  1381. #define U_S(what) ((U16)cast_ulong((double)(what)))
  1382. #define U_I(what) ((unsigned int)cast_ulong((double)(what)))
  1383. #define U_L(what) (cast_ulong((double)(what)))
  1384. #endif
  1385.  
  1386. #ifdef CASTI32
  1387. #define I_32(what) ((I32)(what))
  1388. #define I_V(what) ((IV)(what))
  1389. #define U_V(what) ((UV)(what))
  1390. #else
  1391. START_EXTERN_C
  1392. I32 cast_i32 _((double));
  1393. IV cast_iv _((double));
  1394. UV cast_uv _((double));
  1395. END_EXTERN_C
  1396. #define I_32(what) (cast_i32((double)(what)))
  1397. #define I_V(what) (cast_iv((double)(what)))
  1398. #define U_V(what) (cast_uv((double)(what)))
  1399. #endif
  1400.  
  1401. struct Outrec {
  1402.     I32        o_lines;
  1403.     char    *o_str;
  1404.     U32        o_len;
  1405. };
  1406.  
  1407. #ifndef MAXSYSFD
  1408. #   define MAXSYSFD 2
  1409. #endif
  1410.  
  1411. #ifndef TMPPATH
  1412. #  define TMPPATH "/tmp/perl-eXXXXXX"
  1413. #endif
  1414.  
  1415. #ifndef __cplusplus
  1416. Uid_t getuid _((void));
  1417. Uid_t geteuid _((void));
  1418. Gid_t getgid _((void));
  1419. Gid_t getegid _((void));
  1420. #endif
  1421.  
  1422. #ifdef DEBUGGING
  1423. #ifndef Perl_debug_log
  1424. #define Perl_debug_log    PerlIO_stderr()
  1425. #endif
  1426. #define YYDEBUG 1
  1427. #define DEB(a)                 a
  1428. #define DEBUG(a)   if (PL_debug)        a
  1429. #define DEBUG_p(a) if (PL_debug & 1)    a
  1430. #define DEBUG_s(a) if (PL_debug & 2)    a
  1431. #define DEBUG_l(a) if (PL_debug & 4)    a
  1432. #define DEBUG_t(a) if (PL_debug & 8)    a
  1433. #define DEBUG_o(a) if (PL_debug & 16)    a
  1434. #define DEBUG_c(a) if (PL_debug & 32)    a
  1435. #define DEBUG_P(a) if (PL_debug & 64)    a
  1436. #define DEBUG_m(a) if (PL_curinterp && PL_debug & 128)    a
  1437. #define DEBUG_f(a) if (PL_debug & 256)    a
  1438. #define DEBUG_r(a) if (PL_debug & 512)    a
  1439. #define DEBUG_x(a) if (PL_debug & 1024)    a
  1440. #define DEBUG_u(a) if (PL_debug & 2048)    a
  1441. #define DEBUG_L(a) if (PL_debug & 4096)    a
  1442. #define DEBUG_H(a) if (PL_debug & 8192)    a
  1443. #define DEBUG_X(a) if (PL_debug & 16384)    a
  1444. #define DEBUG_D(a) if (PL_debug & 32768)    a
  1445. #else
  1446. #define DEB(a)
  1447. #define DEBUG(a)
  1448. #define DEBUG_p(a)
  1449. #define DEBUG_s(a)
  1450. #define DEBUG_l(a)
  1451. #define DEBUG_t(a)
  1452. #define DEBUG_o(a)
  1453. #define DEBUG_c(a)
  1454. #define DEBUG_P(a)
  1455. #define DEBUG_m(a)
  1456. #define DEBUG_f(a)
  1457. #define DEBUG_r(a)
  1458. #define DEBUG_x(a)
  1459. #define DEBUG_u(a)
  1460. #define DEBUG_L(a)
  1461. #define DEBUG_H(a)
  1462. #define DEBUG_X(a)
  1463. #define DEBUG_D(a)
  1464. #endif
  1465. #define YYMAXDEPTH 300
  1466.  
  1467. #ifndef assert  /* <assert.h> might have been included somehow */
  1468. #define assert(what)    DEB( {                        \
  1469.     if (!(what)) {                            \
  1470.         croak("Assertion failed: file \"%s\", line %d",        \
  1471.         __FILE__, __LINE__);                    \
  1472.         PerlProc_exit(1);                            \
  1473.     }})
  1474. #endif
  1475.  
  1476. struct ufuncs {
  1477.     I32 (*uf_val)_((IV, SV*));
  1478.     I32 (*uf_set)_((IV, SV*));
  1479.     IV uf_index;
  1480. };
  1481.  
  1482. /* Fix these up for __STDC__ */
  1483. #ifndef DONT_DECLARE_STD
  1484. char *mktemp _((char*));
  1485. double atof _((const char*));
  1486. #endif
  1487.  
  1488. #ifndef STANDARD_C
  1489. /* All of these are in stdlib.h or time.h for ANSI C */
  1490. Time_t time();
  1491. struct tm *gmtime(), *localtime();
  1492. char *strchr(), *strrchr();
  1493. char *strcpy(), *strcat();
  1494. #endif /* ! STANDARD_C */
  1495.  
  1496.  
  1497. #ifdef I_MATH
  1498. #    include <math.h>
  1499. #else
  1500. START_EXTERN_C
  1501.         double exp _((double));
  1502.         double log _((double));
  1503.         double log10 _((double));
  1504.         double sqrt _((double));
  1505.         double frexp _((double,int*));
  1506.         double ldexp _((double,int));
  1507.         double modf _((double,double*));
  1508.         double sin _((double));
  1509.         double cos _((double));
  1510.         double atan2 _((double,double));
  1511.         double pow _((double,double));
  1512. END_EXTERN_C
  1513. #endif
  1514.  
  1515. #ifndef __cplusplus
  1516. #  ifdef __NeXT__ /* or whatever catches all NeXTs */
  1517. char *crypt ();       /* Maybe more hosts will need the unprototyped version */
  1518. #  else
  1519. #    if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
  1520. char *crypt _((const char*, const char*));
  1521. #    endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
  1522. #  endif /* !__NeXT__ */
  1523. #  ifndef DONT_DECLARE_STD
  1524. #    ifndef getenv
  1525. char *getenv _((const char*));
  1526. #    endif /* !getenv */
  1527. Off_t lseek _((int,Off_t,int));
  1528. #  endif /* !DONT_DECLARE_STD */
  1529. char *getlogin _((void));
  1530. #endif /* !__cplusplus */
  1531.  
  1532. #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
  1533. #define UNLINK unlnk
  1534. I32 unlnk _((char*));
  1535. #else
  1536. #define UNLINK unlink
  1537. #endif
  1538.  
  1539. #ifndef HAS_SETREUID
  1540. #  ifdef HAS_SETRESUID
  1541. #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
  1542. #    define HAS_SETREUID
  1543. #  endif
  1544. #endif
  1545. #ifndef HAS_SETREGID
  1546. #  ifdef HAS_SETRESGID
  1547. #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
  1548. #    define HAS_SETREGID
  1549. #  endif
  1550. #endif
  1551.  
  1552. typedef Signal_t (*Sighandler_t) _((int));
  1553.  
  1554. #ifdef HAS_SIGACTION
  1555. typedef struct sigaction Sigsave_t;
  1556. #else
  1557. typedef Sighandler_t Sigsave_t;
  1558. #endif
  1559.  
  1560. #define SCAN_DEF 0
  1561. #define SCAN_TR 1
  1562. #define SCAN_REPL 2
  1563.  
  1564. #ifdef DEBUGGING
  1565. # ifndef register
  1566. #  define register
  1567. # endif
  1568. # define PAD_SV(po) pad_sv(po)
  1569. # define RUNOPS_DEFAULT runops_debug
  1570. #else
  1571. # define PAD_SV(po) PL_curpad[po]
  1572. # define RUNOPS_DEFAULT runops_standard
  1573. #endif
  1574.  
  1575. #ifdef MYMALLOC
  1576. #  define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
  1577. #  define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
  1578. #else
  1579. #  define MALLOC_INIT
  1580. #  define MALLOC_TERM
  1581. #endif
  1582.  
  1583.  
  1584. /*
  1585.  * These need prototyping here because <proto.h> isn't
  1586.  * included until after runops is initialised.
  1587.  */
  1588.  
  1589. #ifndef PERL_OBJECT
  1590. typedef int runops_proc_t _((void));
  1591. int runops_standard _((void));
  1592. #ifdef DEBUGGING
  1593. int runops_debug _((void));
  1594. #endif
  1595. #endif  /* PERL_OBJECT */
  1596.  
  1597. /* _ (for $_) must be first in the following list (DEFSV requires it) */
  1598. #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
  1599.  
  1600. /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
  1601. #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
  1602. #if !defined(DONT_DECLARE_STD) \
  1603.     || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
  1604.     || defined(__sgi) || defined(__DGUX)
  1605. extern char **    environ;    /* environment variables supplied via exec */
  1606. #endif
  1607. #else
  1608. #  if defined(NeXT) && defined(__DYNAMIC__)
  1609.  
  1610. #  include <mach-o/dyld.h>
  1611. EXT char *** environ_pointer;
  1612. #  define environ (*environ_pointer)
  1613. #  endif
  1614. #endif /* environ processing */
  1615.  
  1616.  
  1617. /* for tmp use in stupid debuggers */
  1618. EXT int *    di;
  1619. EXT short *    ds;
  1620. EXT char *    dc;
  1621.  
  1622. /* handy constants */
  1623. EXTCONST char warn_uninit[]
  1624.   INIT("Use of uninitialized value");
  1625. EXTCONST char warn_nosemi[]
  1626.   INIT("Semicolon seems to be missing");
  1627. EXTCONST char warn_reserved[]
  1628.   INIT("Unquoted string \"%s\" may clash with future reserved word");
  1629. EXTCONST char warn_nl[]
  1630.   INIT("Unsuccessful %s on filename containing newline");
  1631. EXTCONST char no_wrongref[]
  1632.   INIT("Can't use %s ref as %s ref");
  1633. EXTCONST char no_symref[]
  1634.   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
  1635. EXTCONST char no_usym[]
  1636.   INIT("Can't use an undefined value as %s reference");
  1637. EXTCONST char no_aelem[]
  1638.   INIT("Modification of non-creatable array value attempted, subscript %d");
  1639. EXTCONST char no_helem[]
  1640.   INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
  1641. EXTCONST char no_modify[]
  1642.   INIT("Modification of a read-only value attempted");
  1643. EXTCONST char no_mem[]
  1644.   INIT("Out of memory!\n");
  1645. EXTCONST char no_security[]
  1646.   INIT("Insecure dependency in %s%s");
  1647. EXTCONST char no_sock_func[]
  1648.   INIT("Unsupported socket function \"%s\" called");
  1649. EXTCONST char no_dir_func[]
  1650.   INIT("Unsupported directory function \"%s\" called");
  1651. EXTCONST char no_func[]
  1652.   INIT("The %s function is unimplemented");
  1653. EXTCONST char no_myglob[]
  1654.   INIT("\"my\" variable %s can't be in a package");
  1655.  
  1656. #ifdef DOINIT
  1657. EXT char *sig_name[] = { SIG_NAME };
  1658. EXT int   sig_num[]  = { SIG_NUM };
  1659. EXT SV    * psig_ptr[sizeof(sig_num)/sizeof(*sig_num)];
  1660. EXT SV  * psig_name[sizeof(sig_num)/sizeof(*sig_num)];
  1661. #else
  1662. EXT char *sig_name[];
  1663. EXT int   sig_num[];
  1664. EXT SV  * psig_ptr[];
  1665. EXT SV  * psig_name[];
  1666. #endif
  1667.  
  1668. /* fast case folding tables */
  1669.  
  1670. #ifdef DOINIT
  1671. EXTCONST  unsigned char fold[] = {
  1672.     0,    1,    2,    3,    4,    5,    6,    7,
  1673.     8,    9,    10,    11,    12,    13,    14,    15,
  1674.     16,    17,    18,    19,    20,    21,    22,    23,
  1675.     24,    25,    26,    27,    28,    29,    30,    31,
  1676.     32,    33,    34,    35,    36,    37,    38,    39,
  1677.     40,    41,    42,    43,    44,    45,    46,    47,
  1678.     48,    49,    50,    51,    52,    53,    54,    55,
  1679.     56,    57,    58,    59,    60,    61,    62,    63,
  1680.     64,    'a',    'b',    'c',    'd',    'e',    'f',    'g',
  1681.     'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
  1682.     'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
  1683.     'x',    'y',    'z',    91,    92,    93,    94,    95,
  1684.     96,    'A',    'B',    'C',    'D',    'E',    'F',    'G',
  1685.     'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
  1686.     'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
  1687.     'X',    'Y',    'Z',    123,    124,    125,    126,    127,
  1688.     128,    129,    130,    131,    132,    133,    134,    135,
  1689.     136,    137,    138,    139,    140,    141,    142,    143,
  1690.     144,    145,    146,    147,    148,    149,    150,    151,
  1691.     152,    153,    154,    155,    156,    157,    158,    159,
  1692.     160,    161,    162,    163,    164,    165,    166,    167,
  1693.     168,    169,    170,    171,    172,    173,    174,    175,
  1694.     176,    177,    178,    179,    180,    181,    182,    183,
  1695.     184,    185,    186,    187,    188,    189,    190,    191,
  1696.     192,    193,    194,    195,    196,    197,    198,    199,
  1697.     200,    201,    202,    203,    204,    205,    206,    207,
  1698.     208,    209,    210,    211,    212,    213,    214,    215,
  1699.     216,    217,    218,    219,    220,    221,    222,    223,    
  1700.     224,    225,    226,    227,    228,    229,    230,    231,
  1701.     232,    233,    234,    235,    236,    237,    238,    239,
  1702.     240,    241,    242,    243,    244,    245,    246,    247,
  1703.     248,    249,    250,    251,    252,    253,    254,    255
  1704. };
  1705. #else
  1706. EXTCONST unsigned char fold[];
  1707. #endif
  1708.  
  1709. #ifdef DOINIT
  1710. EXT unsigned char fold_locale[] = {
  1711.     0,    1,    2,    3,    4,    5,    6,    7,
  1712.     8,    9,    10,    11,    12,    13,    14,    15,
  1713.     16,    17,    18,    19,    20,    21,    22,    23,
  1714.     24,    25,    26,    27,    28,    29,    30,    31,
  1715.     32,    33,    34,    35,    36,    37,    38,    39,
  1716.     40,    41,    42,    43,    44,    45,    46,    47,
  1717.     48,    49,    50,    51,    52,    53,    54,    55,
  1718.     56,    57,    58,    59,    60,    61,    62,    63,
  1719.     64,    'a',    'b',    'c',    'd',    'e',    'f',    'g',
  1720.     'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
  1721.     'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
  1722.     'x',    'y',    'z',    91,    92,    93,    94,    95,
  1723.     96,    'A',    'B',    'C',    'D',    'E',    'F',    'G',
  1724.     'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
  1725.     'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
  1726.     'X',    'Y',    'Z',    123,    124,    125,    126,    127,
  1727.     128,    129,    130,    131,    132,    133,    134,    135,
  1728.     136,    137,    138,    139,    140,    141,    142,    143,
  1729.     144,    145,    146,    147,    148,    149,    150,    151,
  1730.     152,    153,    154,    155,    156,    157,    158,    159,
  1731.     160,    161,    162,    163,    164,    165,    166,    167,
  1732.     168,    169,    170,    171,    172,    173,    174,    175,
  1733.     176,    177,    178,    179,    180,    181,    182,    183,
  1734.     184,    185,    186,    187,    188,    189,    190,    191,
  1735.     192,    193,    194,    195,    196,    197,    198,    199,
  1736.     200,    201,    202,    203,    204,    205,    206,    207,
  1737.     208,    209,    210,    211,    212,    213,    214,    215,
  1738.     216,    217,    218,    219,    220,    221,    222,    223,    
  1739.     224,    225,    226,    227,    228,    229,    230,    231,
  1740.     232,    233,    234,    235,    236,    237,    238,    239,
  1741.     240,    241,    242,    243,    244,    245,    246,    247,
  1742.     248,    249,    250,    251,    252,    253,    254,    255
  1743. };
  1744. #else
  1745. EXT unsigned char fold_locale[];
  1746. #endif
  1747.  
  1748. #ifdef DOINIT
  1749. EXTCONST unsigned char freq[] = {    /* letter frequencies for mixed English/C */
  1750.     1,    2,    84,    151,    154,    155,    156,    157,
  1751.     165,    246,    250,    3,    158,    7,    18,    29,
  1752.     40,    51,    62,    73,    85,    96,    107,    118,
  1753.     129,    140,    147,    148,    149,    150,    152,    153,
  1754.     255,    182,    224,    205,    174,    176,    180,    217,
  1755.     233,    232,    236,    187,    235,    228,    234,    226,
  1756.     222,    219,    211,    195,    188,    193,    185,    184,
  1757.     191,    183,    201,    229,    181,    220,    194,    162,
  1758.     163,    208,    186,    202,    200,    218,    198,    179,
  1759.     178,    214,    166,    170,    207,    199,    209,    206,
  1760.     204,    160,    212,    216,    215,    192,    175,    173,
  1761.     243,    172,    161,    190,    203,    189,    164,    230,
  1762.     167,    248,    227,    244,    242,    255,    241,    231,
  1763.     240,    253,    169,    210,    245,    237,    249,    247,
  1764.     239,    168,    252,    251,    254,    238,    223,    221,
  1765.     213,    225,    177,    197,    171,    196,    159,    4,
  1766.     5,    6,    8,    9,    10,    11,    12,    13,
  1767.     14,    15,    16,    17,    19,    20,    21,    22,
  1768.     23,    24,    25,    26,    27,    28,    30,    31,
  1769.     32,    33,    34,    35,    36,    37,    38,    39,
  1770.     41,    42,    43,    44,    45,    46,    47,    48,
  1771.     49,    50,    52,    53,    54,    55,    56,    57,
  1772.     58,    59,    60,    61,    63,    64,    65,    66,
  1773.     67,    68,    69,    70,    71,    72,    74,    75,
  1774.     76,    77,    78,    79,    80,    81,    82,    83,
  1775.     86,    87,    88,    89,    90,    91,    92,    93,
  1776.     94,    95,    97,    98,    99,    100,    101,    102,
  1777.     103,    104,    105,    106,    108,    109,    110,    111,
  1778.     112,    113,    114,    115,    116,    117,    119,    120,
  1779.     121,    122,    123,    124,    125,    126,    127,    128,
  1780.     130,    131,    132,    133,    134,    135,    136,    137,
  1781.     138,    139,    141,    142,    143,    144,    145,    146
  1782. };
  1783. #else
  1784. EXTCONST unsigned char freq[];
  1785. #endif
  1786.  
  1787. #ifdef DEBUGGING
  1788. #ifdef DOINIT
  1789. EXTCONST char* block_type[] = {
  1790.     "NULL",
  1791.     "SUB",
  1792.     "EVAL",
  1793.     "LOOP",
  1794.     "SUBST",
  1795.     "BLOCK",
  1796. };
  1797. #else
  1798. EXTCONST char* block_type[];
  1799. #endif
  1800. #endif
  1801.  
  1802. /*****************************************************************************/
  1803. /* This lexer/parser stuff is currently global since yacc is hard to reenter */
  1804. /*****************************************************************************/
  1805. /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
  1806.  
  1807. #include "perly.h"
  1808.  
  1809. #define LEX_NOTPARSING        11    /* borrowed from toke.c */
  1810.  
  1811. typedef enum {
  1812.     XOPERATOR,
  1813.     XTERM,
  1814.     XREF,
  1815.     XSTATE,
  1816.     XBLOCK,
  1817.     XTERMBLOCK
  1818. } expectation;
  1819.  
  1820.  
  1821.                 /* Note: the lowest 8 bits are reserved for
  1822.                    stuffing into op->op_private */
  1823. #define HINT_INTEGER        0x00000001
  1824. #define HINT_STRICT_REFS    0x00000002
  1825.  
  1826. #define HINT_BLOCK_SCOPE    0x00000100
  1827. #define HINT_STRICT_SUBS    0x00000200
  1828. #define HINT_STRICT_VARS    0x00000400
  1829. #define HINT_LOCALE        0x00000800
  1830.  
  1831. #define HINT_NEW_INTEGER    0x00001000
  1832. #define HINT_NEW_FLOAT        0x00002000
  1833. #define HINT_NEW_BINARY        0x00004000
  1834. #define HINT_NEW_STRING        0x00008000
  1835. #define HINT_NEW_RE        0x00010000
  1836. #define HINT_LOCALIZE_HH    0x00020000 /* %^H needs to be copied */
  1837.  
  1838. #define HINT_RE_TAINT        0x00100000
  1839. #define HINT_RE_EVAL        0x00200000
  1840.  
  1841. /* Various states of an input record separator SV (rs, nrs) */
  1842. #define RsSNARF(sv)   (! SvOK(sv))
  1843. #define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
  1844. #define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
  1845. #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
  1846.  
  1847. /* Enable variables which are pointers to functions */
  1848. #ifdef PERL_OBJECT
  1849. typedef regexp*(CPerlObj::*regcomp_t) _((char* exp, char* xend, PMOP* pm));
  1850. typedef I32 (CPerlObj::*regexec_t) _((regexp* prog, char* stringarg,
  1851.                       char* strend, char* strbeg,
  1852.                       I32 minend, SV* screamer, void* data,
  1853.                       U32 flags));
  1854. #else
  1855. typedef regexp*(*regcomp_t) _((char* exp, char* xend, PMOP* pm));
  1856. typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char*
  1857.                 strbeg, I32 minend, SV* screamer, void* data, 
  1858.                 U32 flags));
  1859.  
  1860. #endif
  1861.  
  1862. /* Set up PERLVAR macros for populating structs */
  1863. #define PERLVAR(var,type) type var;
  1864. #define PERLVARI(var,type,init) type var;
  1865. #define PERLVARIC(var,type,init) type var;
  1866.  
  1867. /* Interpreter exitlist entry */
  1868. typedef struct exitlistentry {
  1869. #ifdef PERL_OBJECT
  1870.     void (*fn) _((CPerlObj*, void*));
  1871. #else
  1872.     void (*fn) _((void*));
  1873. #endif
  1874.     void *ptr;
  1875. } PerlExitListEntry;
  1876.  
  1877. #ifdef PERL_OBJECT
  1878. extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*));
  1879.  
  1880. typedef int (CPerlObj::*runops_proc_t) _((void));
  1881. #undef EXT
  1882. #define EXT
  1883. #undef EXTCONST
  1884. #define EXTCONST
  1885. #undef INIT
  1886. #define INIT(x)
  1887.  
  1888. class CPerlObj {
  1889. public:
  1890.     CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
  1891.     void Init(void);
  1892.     void* operator new(size_t nSize, IPerlMem *pvtbl);
  1893. #endif /* PERL_OBJECT */
  1894.  
  1895. #ifdef PERL_GLOBAL_STRUCT
  1896. struct perl_vars {
  1897. #include "perlvars.h"
  1898. };
  1899.  
  1900. #ifdef PERL_CORE
  1901. EXT struct perl_vars PL_Vars;
  1902. EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
  1903. #else /* PERL_CORE */
  1904. #if !defined(__GNUC__) || !defined(WIN32)
  1905. EXT
  1906. #endif /* WIN32 */
  1907. struct perl_vars *PL_VarsPtr;
  1908. #define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr =  Perl_GetVars())))
  1909. #endif /* PERL_CORE */
  1910. #endif /* PERL_GLOBAL_STRUCT */
  1911.  
  1912. #ifdef MULTIPLICITY
  1913. /* If we have multiple interpreters define a struct 
  1914.    holding variables which must be per-interpreter
  1915.    If we don't have threads anything that would have 
  1916.    be per-thread is per-interpreter.
  1917. */
  1918.  
  1919. struct interpreter {
  1920. #ifndef USE_THREADS
  1921. #include "thrdvar.h"
  1922. #endif
  1923. #include "intrpvar.h"
  1924. };
  1925.  
  1926. #else
  1927. struct interpreter {
  1928.     char broiled;
  1929. };
  1930. #endif
  1931.  
  1932. #ifdef USE_THREADS
  1933. /* If we have threads define a struct with all the variables
  1934.  * that have to be per-thread
  1935.  */
  1936.  
  1937.  
  1938. struct perl_thread {
  1939. #include "thrdvar.h"
  1940. };
  1941.  
  1942. typedef struct perl_thread *Thread;
  1943.  
  1944. #else
  1945. typedef void *Thread;
  1946. #endif
  1947.  
  1948. /* Done with PERLVAR macros for now ... */
  1949. #undef PERLVAR
  1950. #undef PERLVARI
  1951. #undef PERLVARIC
  1952.  
  1953. #include "thread.h"
  1954. #include "pp.h"
  1955. #include "proto.h"
  1956.  
  1957. #ifdef EMBED
  1958. #define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
  1959. #define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
  1960. #else
  1961. #define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
  1962. #define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
  1963. #endif
  1964.  
  1965. /* The following must follow proto.h as #defines mess up syntax */
  1966.  
  1967. #include "embedvar.h"
  1968.  
  1969. /* Now include all the 'global' variables 
  1970.  * If we don't have threads or multiple interpreters
  1971.  * these include variables that would have been their struct-s 
  1972.  */
  1973.                          
  1974. #define PERLVAR(var,type) EXT type PL_##var;
  1975. #define PERLVARI(var,type,init) EXT type  PL_##var INIT(init);
  1976. #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
  1977.  
  1978. #ifndef PERL_GLOBAL_STRUCT
  1979. #include "perlvars.h"
  1980. #endif
  1981.  
  1982. #ifndef MULTIPLICITY
  1983.  
  1984. #  include "intrpvar.h"
  1985. #  ifndef USE_THREADS
  1986. #    include "thrdvar.h"
  1987. #  endif
  1988.  
  1989. #endif
  1990.  
  1991. #ifdef PERL_OBJECT
  1992. };
  1993.  
  1994. #include "objpp.h"
  1995. #ifdef DOINIT
  1996. #include "INTERN.h"
  1997. #else
  1998. #include "EXTERN.h"
  1999. #endif
  2000. #endif  /* PERL_OBJECT */
  2001.  
  2002.  
  2003. #undef PERLVAR
  2004. #undef PERLVARI
  2005. #undef PERLVARIC
  2006.  
  2007. #if defined(HASATTRIBUTE) && defined(WIN32)
  2008. /*
  2009.  * This provides a layer of functions and macros to ensure extensions will
  2010.  * get to use the same RTL functions as the core.
  2011.  * It has to go here or #define of printf messes up __attribute__
  2012.  * stuff in proto.h  
  2013.  */
  2014. #ifndef PERL_OBJECT
  2015. #  include <win32iop.h>
  2016. #endif  /* PERL_OBJECT */
  2017. #endif    /* WIN32 */
  2018.  
  2019. #ifdef DOINIT
  2020.  
  2021. EXT MGVTBL vtbl_sv =    {magic_get,
  2022.                 magic_set,
  2023.                     magic_len,
  2024.                         0,    0};
  2025. EXT MGVTBL vtbl_env =    {0,    magic_set_all_env,
  2026.                 0,    magic_clear_all_env,
  2027.                             0};
  2028. EXT MGVTBL vtbl_envelem =    {0,    magic_setenv,
  2029.                     0,    magic_clearenv,
  2030.                             0};
  2031. EXT MGVTBL vtbl_sig =    {0,    0,         0, 0, 0};
  2032. EXT MGVTBL vtbl_sigelem =    {magic_getsig,
  2033.                     magic_setsig,
  2034.                     0,    magic_clearsig,
  2035.                             0};
  2036. EXT MGVTBL vtbl_pack =    {0,    0,    magic_sizepack,    magic_wipepack,
  2037.                             0};
  2038. EXT MGVTBL vtbl_packelem =    {magic_getpack,
  2039.                 magic_setpack,
  2040.                     0,    magic_clearpack,
  2041.                             0};
  2042. EXT MGVTBL vtbl_dbline =    {0,    magic_setdbline,
  2043.                     0,    0,    0};
  2044. EXT MGVTBL vtbl_isa =    {0,    magic_setisa,
  2045.                     0,    magic_setisa,
  2046.                             0};
  2047. EXT MGVTBL vtbl_isaelem =    {0,    magic_setisa,
  2048.                     0,    0,    0};
  2049. EXT MGVTBL vtbl_arylen =    {magic_getarylen,
  2050.                 magic_setarylen,
  2051.                     0,    0,    0};
  2052. EXT MGVTBL vtbl_glob =    {magic_getglob,
  2053.                 magic_setglob,
  2054.                     0,    0,    0};
  2055. EXT MGVTBL vtbl_mglob =    {0,    magic_setmglob,
  2056.                     0,    0,    0};
  2057. EXT MGVTBL vtbl_nkeys =    {magic_getnkeys,
  2058.                 magic_setnkeys,
  2059.                     0,    0,    0};
  2060. EXT MGVTBL vtbl_taint =    {magic_gettaint,magic_settaint,
  2061.                     0,    0,    0};
  2062. EXT MGVTBL vtbl_substr =    {magic_getsubstr, magic_setsubstr,
  2063.                     0,    0,    0};
  2064. EXT MGVTBL vtbl_vec =    {magic_getvec,
  2065.                 magic_setvec,
  2066.                     0,    0,    0};
  2067. EXT MGVTBL vtbl_pos =    {magic_getpos,
  2068.                 magic_setpos,
  2069.                     0,    0,    0};
  2070. EXT MGVTBL vtbl_bm =    {0,    magic_setbm,
  2071.                     0,    0,    0};
  2072. EXT MGVTBL vtbl_fm =    {0,    magic_setfm,
  2073.                     0,    0,    0};
  2074. EXT MGVTBL vtbl_uvar =    {magic_getuvar,
  2075.                 magic_setuvar,
  2076.                     0,    0,    0};
  2077. #ifdef USE_THREADS
  2078. EXT MGVTBL vtbl_mutex =    {0,    0,    0,    0,    magic_mutexfree};
  2079. #endif /* USE_THREADS */
  2080. EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
  2081.                     0,    0,    0};
  2082.  
  2083. EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
  2084.  
  2085. #ifdef USE_LOCALE_COLLATE
  2086. EXT MGVTBL vtbl_collxfrm = {0,
  2087.                 magic_setcollxfrm,
  2088.                     0,    0,    0};
  2089. #endif
  2090.  
  2091. #ifdef OVERLOAD
  2092. EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
  2093.                                         0,      0,      magic_setamagic};
  2094. EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
  2095.                                         0,      0,      magic_setamagic};
  2096. #endif /* OVERLOAD */
  2097.  
  2098. #else /* !DOINIT */
  2099.  
  2100. EXT MGVTBL vtbl_sv;
  2101. EXT MGVTBL vtbl_env;
  2102. EXT MGVTBL vtbl_envelem;
  2103. EXT MGVTBL vtbl_sig;
  2104. EXT MGVTBL vtbl_sigelem;
  2105. EXT MGVTBL vtbl_pack;
  2106. EXT MGVTBL vtbl_packelem;
  2107. EXT MGVTBL vtbl_dbline;
  2108. EXT MGVTBL vtbl_isa;
  2109. EXT MGVTBL vtbl_isaelem;
  2110. EXT MGVTBL vtbl_arylen;
  2111. EXT MGVTBL vtbl_glob;
  2112. EXT MGVTBL vtbl_mglob;
  2113. EXT MGVTBL vtbl_nkeys;
  2114. EXT MGVTBL vtbl_taint;
  2115. EXT MGVTBL vtbl_substr;
  2116. EXT MGVTBL vtbl_vec;
  2117. EXT MGVTBL vtbl_pos;
  2118. EXT MGVTBL vtbl_bm;
  2119. EXT MGVTBL vtbl_fm;
  2120. EXT MGVTBL vtbl_uvar;
  2121.  
  2122. #ifdef USE_THREADS
  2123. EXT MGVTBL vtbl_mutex;
  2124. #endif /* USE_THREADS */
  2125.  
  2126. EXT MGVTBL vtbl_defelem;
  2127. EXT MGVTBL vtbl_regexp;
  2128.  
  2129. #ifdef USE_LOCALE_COLLATE
  2130. EXT MGVTBL vtbl_collxfrm;
  2131. #endif
  2132.  
  2133. #ifdef OVERLOAD
  2134. EXT MGVTBL vtbl_amagic;
  2135. EXT MGVTBL vtbl_amagicelem;
  2136. #endif /* OVERLOAD */
  2137.  
  2138. #endif /* !DOINIT */
  2139.  
  2140. #ifdef OVERLOAD
  2141.  
  2142. #define NofAMmeth 58
  2143. #ifdef DOINIT
  2144. EXTCONST char * AMG_names[NofAMmeth] = {
  2145.   "fallback",    "abs",            /* "fallback" should be the first. */
  2146.   "bool",    "nomethod",
  2147.   "\"\"",    "0+",
  2148.   "+",        "+=",
  2149.   "-",        "-=",
  2150.   "*",        "*=",
  2151.   "/",        "/=",
  2152.   "%",        "%=",
  2153.   "**",        "**=",
  2154.   "<<",        "<<=",
  2155.   ">>",        ">>=",
  2156.   "&",        "&=",
  2157.   "|",        "|=",
  2158.   "^",        "^=",
  2159.   "<",        "<=",
  2160.   ">",        ">=",
  2161.   "==",        "!=",
  2162.   "<=>",    "cmp",
  2163.   "lt",        "le",
  2164.   "gt",        "ge",
  2165.   "eq",        "ne",
  2166.   "!",        "~",
  2167.   "++",        "--",
  2168.   "atan2",    "cos",
  2169.   "sin",    "exp",
  2170.   "log",    "sqrt",
  2171.   "x",        "x=",
  2172.   ".",        ".=",
  2173.   "=",        "neg"
  2174. };
  2175. #else
  2176. EXTCONST char * AMG_names[NofAMmeth];
  2177. #endif /* def INITAMAGIC */
  2178.  
  2179. struct am_table {
  2180.   long was_ok_sub;
  2181.   long was_ok_am;
  2182.   U32 flags;
  2183.   CV* table[NofAMmeth];
  2184.   long fallback;
  2185. };
  2186. struct am_table_short {
  2187.   long was_ok_sub;
  2188.   long was_ok_am;
  2189.   U32 flags;
  2190. };
  2191. typedef struct am_table AMT;
  2192. typedef struct am_table_short AMTS;
  2193.  
  2194. #define AMGfallNEVER    1
  2195. #define AMGfallNO    2
  2196. #define AMGfallYES    3
  2197.  
  2198. #define AMTf_AMAGIC        1
  2199. #define AMT_AMAGIC(amt)        ((amt)->flags & AMTf_AMAGIC)
  2200. #define AMT_AMAGIC_on(amt)    ((amt)->flags |= AMTf_AMAGIC)
  2201. #define AMT_AMAGIC_off(amt)    ((amt)->flags &= ~AMTf_AMAGIC)
  2202.  
  2203. enum {
  2204.   fallback_amg,    abs_amg,
  2205.   bool__amg,    nomethod_amg,
  2206.   string_amg,    numer_amg,
  2207.   add_amg,    add_ass_amg,
  2208.   subtr_amg,    subtr_ass_amg,
  2209.   mult_amg,    mult_ass_amg,
  2210.   div_amg,    div_ass_amg,
  2211.   modulo_amg,    modulo_ass_amg,
  2212.   pow_amg,    pow_ass_amg,
  2213.   lshift_amg,    lshift_ass_amg,
  2214.   rshift_amg,    rshift_ass_amg,
  2215.   band_amg,    band_ass_amg,
  2216.   bor_amg,    bor_ass_amg,
  2217.   bxor_amg,    bxor_ass_amg,
  2218.   lt_amg,    le_amg,
  2219.   gt_amg,    ge_amg,
  2220.   eq_amg,    ne_amg,
  2221.   ncmp_amg,    scmp_amg,
  2222.   slt_amg,    sle_amg,
  2223.   sgt_amg,    sge_amg,
  2224.   seq_amg,    sne_amg,
  2225.   not_amg,    compl_amg,
  2226.   inc_amg,    dec_amg,
  2227.   atan2_amg,    cos_amg,
  2228.   sin_amg,    exp_amg,
  2229.   log_amg,    sqrt_amg,
  2230.   repeat_amg,   repeat_ass_amg,
  2231.   concat_amg,    concat_ass_amg,
  2232.   copy_amg,    neg_amg
  2233. };
  2234.  
  2235. /*
  2236.  * some compilers like to redefine cos et alia as faster
  2237.  * (and less accurate?) versions called F_cos et cetera (Quidquid
  2238.  * latine dictum sit, altum viditur.)  This trick collides with
  2239.  * the Perl overloading (amg).  The following #defines fool both.
  2240.  */
  2241.  
  2242. #ifdef _FASTMATH
  2243. #   ifdef atan2
  2244. #       define F_atan2_amg  atan2_amg
  2245. #   endif
  2246. #   ifdef cos
  2247. #       define F_cos_amg    cos_amg
  2248. #   endif
  2249. #   ifdef exp
  2250. #       define F_exp_amg    exp_amg
  2251. #   endif
  2252. #   ifdef log
  2253. #       define F_log_amg    log_amg
  2254. #   endif
  2255. #   ifdef pow
  2256. #       define F_pow_amg    pow_amg
  2257. #   endif
  2258. #   ifdef sin
  2259. #       define F_sin_amg    sin_amg
  2260. #   endif
  2261. #   ifdef sqrt
  2262. #       define F_sqrt_amg   sqrt_amg
  2263. #   endif
  2264. #endif /* _FASTMATH */
  2265.  
  2266. #endif /* OVERLOAD */
  2267.  
  2268. #define PERLDB_ALL    0x3f        /* No _NONAME, _GOTO */
  2269. #define PERLDBf_SUB    0x01        /* Debug sub enter/exit. */
  2270. #define PERLDBf_LINE    0x02        /* Keep line #. */
  2271. #define PERLDBf_NOOPT    0x04        /* Switch off optimizations. */
  2272. #define PERLDBf_INTER    0x08        /* Preserve more data for
  2273.                        later inspections.  */
  2274. #define PERLDBf_SUBLINE    0x10        /* Keep subr source lines. */
  2275. #define PERLDBf_SINGLE    0x20        /* Start with single-step on. */
  2276. #define PERLDBf_NONAME    0x40        /* For _SUB: no name of the subr. */
  2277. #define PERLDBf_GOTO    0x80        /* Report goto: call DB::goto. */
  2278.  
  2279. #define PERLDB_SUB    (PL_perldb && (PL_perldb & PERLDBf_SUB))
  2280. #define PERLDB_LINE    (PL_perldb && (PL_perldb & PERLDBf_LINE))
  2281. #define PERLDB_NOOPT    (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
  2282. #define PERLDB_INTER    (PL_perldb && (PL_perldb & PERLDBf_INTER))
  2283. #define PERLDB_SUBLINE    (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
  2284. #define PERLDB_SINGLE    (PL_perldb && (PL_perldb & PERLDBf_SINGLE))
  2285. #define PERLDB_SUB_NN    (PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
  2286. #define PERLDB_GOTO    (PL_perldb && (PL_perldb & PERLDBf_GOTO))
  2287.  
  2288.  
  2289. #ifdef USE_LOCALE_NUMERIC
  2290.  
  2291. #define SET_NUMERIC_STANDARD() \
  2292.     STMT_START {                \
  2293.     if (! PL_numeric_standard)            \
  2294.         perl_set_numeric_standard();    \
  2295.     } STMT_END
  2296.  
  2297. #define SET_NUMERIC_LOCAL() \
  2298.     STMT_START {                \
  2299.     if (! PL_numeric_local)            \
  2300.         perl_set_numeric_local();        \
  2301.     } STMT_END
  2302.  
  2303. #else /* !USE_LOCALE_NUMERIC */
  2304.  
  2305. #define SET_NUMERIC_STANDARD()  /**/
  2306. #define SET_NUMERIC_LOCAL()     /**/
  2307.  
  2308. #endif /* !USE_LOCALE_NUMERIC */
  2309.  
  2310. #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
  2311. /* 
  2312.  * Now we have __attribute__ out of the way 
  2313.  * Remap printf 
  2314.  */
  2315. #define printf PerlIO_stdoutf
  2316. #endif
  2317.  
  2318. #ifndef PERL_SCRIPT_MODE
  2319. #define PERL_SCRIPT_MODE "r"
  2320. #endif
  2321.  
  2322. /*
  2323.  * nice_chunk and nice_chunk size need to be set
  2324.  * and queried under the protection of sv_mutex
  2325.  */
  2326. #define offer_nice_chunk(chunk, chunk_size) do {    \
  2327.     LOCK_SV_MUTEX;                    \
  2328.     if (!PL_nice_chunk) {                \
  2329.         PL_nice_chunk = (char*)(chunk);        \
  2330.         PL_nice_chunk_size = (chunk_size);        \
  2331.     }                        \
  2332.     else {                        \
  2333.         Safefree(chunk);                \
  2334.     }                        \
  2335.     UNLOCK_SV_MUTEX;                \
  2336.     } while (0)
  2337.  
  2338. #ifdef HAS_SEM
  2339. #   include <sys/ipc.h>
  2340. #   include <sys/sem.h>
  2341. #   ifndef HAS_UNION_SEMUN    /* Provide the union semun. */
  2342.     union semun {
  2343.     int val;
  2344.     struct semid_ds *buf;
  2345.     unsigned short *array;
  2346.     };
  2347. #   endif
  2348. #   ifdef USE_SEMCTL_SEMUN
  2349. #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
  2350. #   else
  2351. #       ifdef USE_SEMCTL_SEMID_DS
  2352. #           define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
  2353. #       endif
  2354. #   endif
  2355. #   ifndef Semctl    /* Place our bets on the semun horse. */
  2356. #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
  2357. #   endif
  2358. #endif
  2359.  
  2360. #endif /* Include guard */
  2361.